System Booster/System Booster.iso/Texteditors/Origami/bindings/fun/spell

Text File | 1996-09-27 | 22.9 KB | 651 lines

@if-using not(ocl-file-spell)
   @use (ocl-file-spell)
   ;OCL{{{}}}
   ;OCL{{{  libs
   @if-using not(ocl-file-delchar) @lib delchar @fi
   ;OCL}}}
   ;OCL{{{  reference description
   @if-using ( FUN-REFERENCE ) ; 1 ;
   This library defines a function, which uses the output  of  `spell'  to
   start an intelligent interactive search and replace.

   If the checked file is read only, the  spelling  errors  will  only  be
   listed in a new buffer. In  this  case, the search and replace will not
   be started!

   If you do not want to use the standard spellchecker `spell', change the
   value of history `spell-command' to your spell checker.

   This package can only be  used,  if  Origami  is  compiled  to  support
   regular expressions.
   @fi
   ;OCL}}}
   ;OCL{{{  variables
   ( defvar
      ( spelled-buffer
        spell-out-buff
        spell-op
        spell-len
        spell-replace-set
        spell-empty-replace
        spell-x
        spell-old-regexp-mode
        spell-view
        spell-mark-word
        spell-mark-used
        spell-pause
        spell-error-line-mark
      )
   )
   ( history spell-command )
   ( history spell-menu )
   ( history spell-replaces )
   ;OCL}}}
   ;OCL{{{  default-spell-command
   @if-using not( NEW-DEF-SPELL )
      ( defmac default-spell-command ( "spell ) )
   @fi
   ;OCL}}}
   ;OCL{{{  special basic regular expression chars
   @if-using not( basic-regexp-chars-defined )
      @use ( basic-regexp-chars-defined )
      ( defset basic-regexp-chars ( "* ". "[ "] "^ "$ "\ ) )
   @fi
   ;OCL}}}
   ;OCL{{{  spell-basic-magic
   ;OCL{{{  define string for missing re
   ( demand-load not (
      ( defmac no-reg-exp
         ( "Sorry, "  "no "  "regular "  "expressions! )
      )
      ( undeclare ( no-reg-exp ) )
   ) )
   ;OCL}}}
   ( defmac spell-basic-magic
      ( delete-mode-regular-expression
        set spell-old-regexp-mode +(1 ocl-argument)
        add-mode-basic-regular-expression
        if =(ocl-argument 0)
         ( message-exit ( "[ "Sorry, "  "no "  "regular "  "expressions! "] ) )
        fi
      )
   )
   ;OCL}}}
   ;OCL{{{  spell-restore-magic
   ( defmac spell-restore-magic
      ( case
         ( pre
            ( set spell-old-regexp-mode -(spell-old-regexp-mode 1) )
              =(spell-old-regexp-mode 0)
            ( delete-mode-regular-expression )
         )
         ( pre
            ( set spell-old-regexp-mode -(spell-old-regexp-mode 1) )
              =(spell-old-regexp-mode 0)
            ( add-mode-basic-regular-expression )
         )
         ( pre
            ( set spell-old-regexp-mode -(spell-old-regexp-mode 1) )
              =(spell-old-regexp-mode 0)
            ( add-mode-extended-regular-expression )
         )
        default
         ( set spell-old-regexp-mode 0 )
        esac
      )
   )
   ;OCL}}}
   ;OCL{{{  spell-end
   ( deffun spell-end
      ( if =(current-buffer-id spell-out-buff)
         ( if spell-mark-used
            ;OCL{{{  remove trailing words and rename buffer
            ( screen-off
              while not(test-bottom)
               ( delete-to-end-of-line
                 next-line
                 delete-previous-character
               )
              previous-line
              delete-previous-character
              set-file-unchanged
              beginning-of-fold
              next-line
              beginning-of-line
              change-buffername
                 "marked-spell-errors
                 newline-and-indent
              screen-on
              redraw-display
            )
            ;OCL}}}
           else
            ;OCL{{{  exit
            ( set-file-unchanged
              exit-buffer
            )
            ;OCL}}}
           fi
         )
        fi
        set spell-out-buff 0
      )
   )
   ;OCL}}}
   ;OCL{{{  spell-buffer
   ;OCL{{{  reference
   @if-using ( FUN-REFERENCE ) ; 2 ; spell-buffer-ref
   ;OCL{{{  @spell-mac-ref spell-buffer
   Start a interactive search and replace for all misspelled words.  If
   you used the Edit facility, the function tries to continue  the  old
   spell check!
   ;OCL}}}
   @fi
   ;OCL}}}
   ;OCL{{{  spell-menu-string
   ;OCL{{{  define sub strings for menus
   ( demand-load not(
      ( defmac first-menu-part
         ( "Ok "  "Next "  "Replace "  )
      )
      ( defmac mid-menu-part
         ( "Substitue "( get-history spell-replaces 0 ") "  "All "   )
      )
      ( defmac last-menu-part
         ( "Edit if =(spell-mark-word 0) ( "  "  "Mark ) fi "  "  "  "Quit  )
      )
   ) )
   ;OCL}}}
   ( deffun spell-menu-string
      ( history-edit spell-menu ()
           first-menu-part
           if spell-replace-set
            ( mid-menu-part )
           fi
           last-menu-part
           newline-and-indent
      )
   )
   ;OCL{{{  undeclare sub strings
   ( undeclare
      ( first-menu-part
        mid-menu-part
        last-menu-part
      )
   )
   ;OCL}}}
   ;OCL}}}
   ( deffun spell-buffer
      (
        ;OCL{{{  check if pausing spell can be restarted
        set spell-op current-buffer-id
        screen-off
        if
         ;OCL{{{  spell-pause and cannot restore handling
         and
            ( spell-pause
              or
               ( <>(spelled-buffer current-buffer-id)
                 pre
                  ( goto-buffer-id spell-out-buff )
                    <>(current-buffer-id spell-out-buff)
                 pre
                  ( goto-line-mark spell-error-line-mark )
                    test-bottom
               )
            )
         ;OCL}}}
         ;OCL{{{  stop old spelling
         ( goto-buffer-id spell-out-buff
           if =(spell-op spell-out-buff)
            ( set spell-out-buff 0 )
           fi
           set spell-pause 0
           spell-end
         )
         ;OCL}}}
        fi
        goto-buffer-id spell-op
        screen-on
        redraw-display
        ;OCL}}}
        if
         ;OCL{{{  paused or normal-file and save succesfull
           or
            ( spell-pause
              not
               ( or
                  ( <>(file-type 0)
                    pre
                     ;OCL{{{  exit folds and save
                     (
                       ;OCL{{{  exit entered folds
                       while set-enter
                        ( exit-fold )
                       ;OCL}}}
                       ;OCL{{{  clear message storage
                       if
                          or
                           ( last-message M_CANTWRITE
                             last-message M_DIR_EDIT
                             last-message M_CLOSE_FAILED
                           )
                        ()
                       fi
                       ;OCL}}}
                       save-file
                     )
                     ;OCL}}}
                     ;OCL{{{  save successfull
                       or
                        ( last-message M_CANTWRITE
                          last-message M_DIR_EDIT
                          last-message M_CLOSE_FAILED
                        )
                     ;OCL}}}
                  )
               )
            )
         ;OCL}}}
         ;OCL{{{  do the spell check
         ( screen-off
           spell-basic-magic
           if not(spell-pause)
            ;OCL{{{  get new info
            ( set spell-mark-used false
              ;OCL{{{  store filedata
              set spelled-buffer current-buffer-id
              set spell-view counter test-view
              history-edit-filename spell-replaces ()
                 newline-and-indent
              ;OCL}}}
              ;OCL{{{  open dev-null buffer
              local
               ( modify-behaviour )
               ( set modify-behaviour -2
                 open-buffer
               )
              ;OCL}}}
              if <>(spelled-buffer current-buffer-id)
               ;OCL{{{  get spell errors and handle them
               ( set spell-out-buff current-buffer-id
                 delete-mode-view
                 ;OCL{{{  show minimized spell-check buffer
                 repeat screen-height
                  ( shrink-buffer )
                 screen-on
                 redraw-display
                 ;OCL}}}
                 ;OCL{{{  get spell info
                 message ( M_READING "  "' history spell-command "  history spell-replaces "' )
                 screen-off
                 local ( force-bourne-shell )
                  ( set force-bourne-shell true
                    pipe-from-command
                       get-history spell-command 0
                       if test-begin-line
                        ( default-spell-command )
                       fi
                       "  ;
                       get-history spell-replaces 0
                       newline-and-indent
                  )
                 beginning-of-fold
                 next-line
                 beginning-of-line
                 center-and-redraw-display
                 ;OCL}}}
                 if ocl-argument
                  ;OCL{{{  command failed, so quit this buffer
                  ( spell-end )
                  ;OCL}}}
                 fi
               )
               ;OCL}}}
              fi
            )
            ;OCL}}}
           else
            ;OCL{{{  restore old info
            ( goto-buffer-id spell-out-buff
              forward-character
              forward-character
            )
            ;OCL}}}
           fi
           screen-on
           redraw-display
           if <>(spelled-buffer current-buffer-id)
            ;OCL{{{  handle the errors
            ( if not(spell-view)
               ;OCL{{{  replace-loop
               ( screen-off
                 set spell-op 0
                 while and(<>(spell-op "q) not(test-bottom))
                  ;OCL{{{  handle word
                  ( goto-buffer-id spell-out-buff
                    ;OCL{{{  init search
                    if spell-pause
                     ;OCL{{{  clear old +/*, use old mark value
                     ( beginning-of-line
                       forward-character
                       forward-character
                       delete-previous-character
                       delete-previous-character
                     )
                     ;OCL}}}
                    else
                     ;OCL{{{  start unmarked
                     ( set spell-mark-word false )
                     ;OCL}}}
                    fi
                    ;OCL{{{  get search pattern and its length
                    set spell-len 0
                    history-edit-line search ()
                       beginning-of-line
                       "\ "( "^\|[^[:alnum:]] "\ ")
                       while not(test-end-line)
                        ( if test-char-set basic-regexp-chars
                           ( "\ )
                          fi
                          forward-character
                          set spell-len +(spell-len 1)
                        )
                       "\ "( "$\|[^[:alnum:]] "\ ")
                       newline-and-indent
                    ;OCL}}}
                    if spell-mark-word ( "* ) else ( "+ ) fi "  ;
                    set spell-error-line-mark store-line-mark
                    ;OCL}}}
                    ;OCL{{{  init replace
                    if not(spell-pause)
                     ( set spell-replace-set false )
                    fi
                    ;OCL}}}
                    ;OCL{{{  init menu
                    spell-menu-string
                    set spell-op 0
                    ;OCL}}}
                    ;OCL{{{  move to search start position in spelled buffer
                    goto-buffer-id spelled-buffer
                    if not(spell-pause)
                     ( beginning-of-fold
                       end-of-line
                     )
                    fi
                    ;OCL}}}
                    set spell-pause false
                    ;OCL{{{  word handling loop
                    local
                     ()
                     ( while
                        ;OCL{{{  found pattern
                          pre
                           ( if last-message M_FAILED () fi
                             search-forward previous-line newline-and-indent
                           )
                             not(last-message M_FAILED)
                        ;OCL}}}
                        (
                          ;OCL{{{  move over leading non-char
                          if not(test-char-set alnum)
                           ( forward-character )
                          fi
                          ;OCL}}}
                          if <>(spell-op "a)
                           ;OCL{{{  get new command
                           ( do
                              (
                                ;OCL{{{  show commands and prompt for action
                                screen-on
                                redraw-display
                                message ( history spell-menu )
                                begin-prompt-macro
                                show-cursor 0
                                prompt-char-counter spell-op ()
                                end-prompt-macro
                                screen-off
                                ;OCL}}}
                                case
                                 ;OCL{{{  q/Q/o/O -> break from word loop
                                 ( =(spell-op "Q)
                                    ( set spell-op "q
                                      return-from-macro
                                    )
                                 )
                                 ( or
                                    ( =(spell-op "o) =(spell-op "O)
                                      =(spell-op "q)
                                    )
                                    ( return-from-macro )
                                 )
                                 ;OCL}}}
                                 ;OCL{{{  e/E -> edit, spell pause
                                 ( or(=(spell-op "e) =(spell-op "E))
                                    ( set spell-pause true
                                      spell-restore-magic
                                      screen-on
                                      redraw-display
                                      @if-using ( PRE-SPELL-EDIT-COMMAND )
                                         pre-spell-edit-command
                                      @fi
                                      message-exit
                                       ( "[ "spell
                                         "  "suspended
                                         "  "for
                                         "  "editing
                                         "]
                                       )
                                    )
                                 )
                                 ;OCL}}}
                                 ;OCL{{{  m/M -> mark word
                                 ( or(=(spell-op "m) =(spell-op "M))
                                    ( set spell-op 0
                                      if not(spell-mark-word)
                                       ( set spell-mark-word true
                                         set spell-mark-used true
                                         spell-menu-string
                                         ;OCL{{{  change marker + -> *
                                         goto-buffer-id spell-out-buff
                                         delete-previous-character
                                         delete-previous-character
                                         "* "  ;
                                         set-file-unchanged
                                         goto-buffer-id spelled-buffer
                                         ;OCL}}}
                                       )
                                      fi
                                    )
                                 )
                                 ;OCL}}}
                                 ;OCL{{{  n/N -> continue loop
                                 ( or(=(spell-op "n) =(spell-op "N))
                                    ( forward-character )
                                 )
                                 ;OCL}}}
                                 ;OCL{{{  r/R -> edit new rep and break prompt loop
                                 ( or(=(spell-op "r) =(spell-op "R))
                                    (
                                      ;OCL{{{  get new replace
                                      screen-on
                                      history-edit spell-replaces ( M_REPLACE )
                                      local
                                       ()
                                       ( do
                                          ( begin-prompt-macro
                                            prompt-char-counter spell-op ()
                                            end-prompt-macro
                                            if =(spell-op newline-and-indent)
                                             ( return-from-macro )
                                            fi
                                            insert-ascii spell-op
                                          )
                                         while true
                                       )
                                      end-of-line
                                      set spell-empty-replace counter test-begin-line
                                      set spell-replace-set true
                                      newline-and-indent
                                      screen-off
                                      ;OCL}}}
                                      ;OCL{{{  buildt new menu
                                      spell-menu-string
                                      ;OCL}}}
                                      set spell-op "s
                                    )
                                 )
                                 ;OCL}}}
                                 ;OCL{{{  no replace set -> loop
                                 ( not(spell-replace-set) ( set spell-op 0 ) )
                                 ;OCL}}}
                                 ;OCL{{{  a/A -> break from prompt loop
                                 ( =(spell-op "a) () )
                                 ( =(spell-op "A) ( set spell-op "a ) )
                                 ;OCL}}}
                                 ;OCL{{{  s/S -> break from prompt loop
                                 ( =(spell-op "s) () )
                                 ( =(spell-op "S) ( set spell-op "s ) )
                                 ;OCL}}}
                                default
                                 ;OCL{{{  continue prompting
                                 ( set spell-op 0 )
                                 ;OCL}}}
                                esac
                              )
                             while =(spell-op 0)
                           )
                           ;OCL}}}
                          fi
                          if or(=(spell-op "s) =(spell-op "a))
                           ;OCL{{{  replace pattern
                           (
                             ;OCL{{{  remove old word
                             local
                              ( spell-len )
                              ( while and(>(spell-len 0) not(test-end-line))
                                 ( forward-character
                                   delete-previous-character
                                   set spell-len -(spell-len 1)
                                 )
                              )
                             ;OCL}}}
                             ;OCL{{{  put new
                             if not(spell-empty-replace)
                              ( get-history spell-replaces 0 )
                             fi
                             ;OCL}}}
                           )
                           ;OCL}}}
                          fi
                        )
                     )
                    ;OCL}}}
                    goto-buffer-id spell-out-buff
                    if spell-mark-word
                     ;OCL{{{  delete mark and move to next
                     ( delete-previous-character
                       delete-previous-character
                       next-line
                     )
                     ;OCL}}}
                    else
                     ;OCL{{{  delete word
                     ( backward-character
                       backward-character
                       delete-to-end-of-line
                       next-line
                       delete-previous-character
                     )
                     ;OCL}}}
                    fi
                    set-file-unchanged
                  )
                  ;OCL}}}
                 spell-end
                 screen-on
                 redraw-display
               )
               ;OCL}}}
              else
               ;OCL{{{  stay buffer
               ( end-of-fold
                 set spell-mark-used true
                 spell-end
               )
               ;OCL}}}
              fi
            )
            ;OCL}}}
           fi
           spell-restore-magic
           message ()
         )
         ;OCL}}}
        fi
      )
   )
   ;OCL{{{  undeclares
   ( undeclare ( spell-menu-string ) )
   ;OCL}}}
   ;OCL}}}
   ;OCL{{{  abort-hook-add
   @if-using not(ABORT-HOOK-ADD)
      @use (ABORT-HOOK-ADD)
      ( defmac abort-hook-add ( ) )
   @fi
   ( defmac abort-hook-add-saved ( abort-hook-add ) )
   ( undeclare ( abort-hook-add ) )
   ( defmac abort-hook-add
      ( abort-hook-add-saved
        set modify-behaviour 0
        spell-restore-magic
        if and(spell-out-buff not(spell-pause))
         ( goto-buffer-id spell-out-buff
           if =(current-buffer-id spell-out-buff)
            ( spell-end
              set spell-out-buff 0
            )
           fi
         )
        fi
      )
   )
   ( undeclare ( abort-hook-add-saved ) )
   ;OCL}}}
   ;OCL{{{  reference hooks
   @if-using ( FUN-REFERENCE ) ; 3 ;
   The libary defines a macro `abort-hook-add' and a OCL tag ABORT-HOOK-ADD.
   This macro should be added to your abort-macro! If needed, an existing macro
   `abort-hook-add' will be integrated!

   If you do not want to use `spell' as default spell checker, define the
   OCL-tag `NEW-DEF-SPELL' and a function `default-spell-command' (the default
   is `(defmac default-spell-command ( "spell ) )').

   If you have to change some internal states, when using the Edit facility,
   define the OCL tag PRE-SPELL-EDIT-COMMAND and a function
   pre-spell-edit-command.
   @fi
   ;OCL}}}
   ;OCL{{{  undeclares
   ( undeclare
      ( spelled-buffer
        spell-out-buff
        spell-op
        spell-len
        spell-replace-set
        spell-empty-replace
        spell-x
        spell-old-regexp-mode
        spell-basic-magic
        spell-restore-magic
        spell-mark-used
        spell-mark-word
        spell-pause
        spell-error-line-mark
      )
   )
   ;OCL}}}
@fi